unit PtSettingsCommon;

interface

uses
  PtSettings, Classes, SysUtils, Types;

type
  //  Settings group with array of strings

  TNumberedStrings = class(TSettingsGroup)
  private
    fStrings: TStringList;
    fCount: integer;
    function GetCount: integer; inline;
  protected
    function  ElemName(const i: integer): string; virtual;
    procedure Loaded(Storage: ISettingsStorage); override;
    procedure Saving(Storage: ISettingsStorage); override;
  public
    constructor Create(const AName: string; const AParent: TSettingsGroup = nil); override;
    destructor  Destroy; override;
    //  The settings are stored in property Strings
    property  Strings : TStringList read fStrings;
  published
    property  Count   : integer     read GetCount write fCount;
  end;

  TFileListSettings = class(TNumberedStrings)
  private
    function GetFileNames: TStringList; inline;
  protected
    function ElemName(const i: Integer): String; override;
  public
    property  FileNames : TStringList read GetFileNames;
  end;

  TNamedStrings = class(TSettingsGroup)
  private
    fNames, fValues: TStringList;
    fClearBeforeLoad: Boolean;
    function  GetCount: integer; inline;
  protected
    function  GetNames(const Index: integer): string; inline;
    function  GetValues(const Index: integer): string; inline;
    procedure SetValues(const Index: integer; const Value: string); inline;
    function  GetByName(const Name: string): string; virtual;
    procedure SetByName(const Name: string; const Value: string); virtual;
    procedure Loaded(Storage: ISettingsStorage); override;
    procedure Saving(Storage: ISettingsStorage); override;
    property  ClearBeforeLoad : Boolean read fClearBeforeLoad write fClearBeforeLoad;
  public
    constructor Create(const AName: string; const AParent: TSettingsGroup = nil); override;
    destructor  Destroy; override;
    property  Count : integer read GetCount;
    property  Names[const Index: integer]   : string  read GetNames;
    property  Values[const Index: integer]  : string  read GetValues  write SetValues;
    property  ByName[const Name: string]    : string  read GetByName  write SetByName;
    procedure FromStrings(const Strings: TStrings);
    procedure ToStrings(const Strings: TStrings);
  end;

  //  Settings group with array of sub-groups

  TNumberedGroups = class(TSettingsGroup)
  private
    fCount: integer;
    function GetCount: integer; inline;
  protected
    function  ElemName(const i: integer): string; virtual;
    procedure Loaded(Storage: ISettingsStorage); override;
    procedure Saving(Storage: ISettingsStorage); override;
    function  ElemType  : TSettingsGroupClass; virtual; abstract;
  public
    function  AddElem: TSettingsGroup;
    procedure DelElem(const Elem: TSettingsGroup); inline;
    function  GetElem(const i: integer): TSettingsGroup; inline;
  published
    property  Count : integer read GetCount write fCount;
  end;

  TNumberedGroups<TSubGroup: TSettingsGroup> = class(TSettingsGroup)
  private
    fCount: integer;
    function GetCount: integer; inline;
  protected
    function  ElemName(const i: integer): string; virtual;
    procedure Loaded(Storage: ISettingsStorage); override;
    procedure Saving(Storage: ISettingsStorage); override;
  public
    function  AddElem: TSubGroup;
    procedure DelElem(const Elem: TSubGroup); inline;
    function  GetElem(const i: integer): TSubGroup; inline;
    property  SubGroups[const i: integer] : TSubGroup  read GetElem;
  published
    property  Count : integer read GetCount write fCount;
  end;

  TNamedGroups = class(TSettingsGroup)
  protected
    procedure Loaded(Storage: ISettingsStorage); override;
    procedure Saving(Storage: ISettingsStorage); override;
    function  ElemType  : TSettingsGroupClass; virtual; abstract;
  public
    function  AddElem(const ElemName: string): TSettingsGroup;
    procedure RemElem(const ElemName: string); inline;
    function  GetElem(const ElemName: string): TSettingsGroup;
  end;

  TNamedGroups<TSubGroup: TSettingsGroup> = class(TSettingsGroup)
  private
    function GetSubGroups(const i: integer): TSubGroup; inline;
  protected
    procedure Loaded(Storage: ISettingsStorage); override;
    procedure Saving(Storage: ISettingsStorage); override;
  public
    function  AddElem(const ElemName: string): TSubGroup;
    procedure RemElem(const ElemName: string); inline;
    function  GetElem(const ElemName: string): TSubGroup;
    property  SubGroups[const i: integer] : TSubGroup  read GetSubGroups;
  end;

  //  Settings group for GUI

  TRectSettings = class(TSettingsGroup)
  private
    fRect: TRect;
  public
    property  Rect    : TRect   read fRect        write fRect;
  published
    property  Left    : integer read fRect.Left   write fRect.Left;
    property  Top     : integer read fRect.Top    write fRect.Top;
    property  Right   : integer read fRect.Right  write fRect.Right;
    property  Bottom  : integer read fRect.Bottom write fRect.Bottom;
  end;

  TComponentSettings = class(TNamedStrings)
  protected
    procedure ValidateParameters(const FuncName: string; const Obj: TComponent; var Name: string);
  public
    function  Load(const Obj: TComponent; Name: string): Boolean;
    procedure Save(const Obj: TComponent);
  end;

function  StorageAsReader(Storage: ISettingsStorage): ISettingsStorageReader;
function  StorageAsWriter(Storage: ISettingsStorage): ISettingsStorageWriter;
function  StorageAsDeleter(Storage: ISettingsStorage): ISettingsStorageDelete;
function  StorageAsQuery(Storage: ISettingsStorage): ISettingsStorageQuery;

implementation

const
  CNotImplementError  = 'Storage does not implement ';

function  StorageAsReader(Storage: ISettingsStorage): ISettingsStorageReader;
begin
  if  not Supports(Storage, ISettingsStorageReader, Result) then
    raise EPtSettings.Create(CNotImplementError+'ISettingsStorageReader');
end;

function  StorageAsWriter(Storage: ISettingsStorage): ISettingsStorageWriter;
begin
  if  not Supports(Storage, ISettingsStorageWriter, Result) then
    raise EPtSettings.Create(CNotImplementError+'ISettingsStorageWriter');
end;

function  StorageAsDeleter(Storage: ISettingsStorage): ISettingsStorageDelete;
begin
  if  not Supports(Storage, ISettingsStorageDelete, Result) then
    raise EPtSettings.Create(CNotImplementError+'ISettingsStorageDelete');
end;

function  StorageAsQuery(Storage: ISettingsStorage): ISettingsStorageQuery;
begin
  if  not Supports(Storage, ISettingsStorageQuery, Result) then
    raise EPtSettings.Create(CNotImplementError+'ISettingsStorageQuery');
end;

{ TNumberedStrings }

constructor TNumberedStrings.Create(const AName: string;
  const AParent: TSettingsGroup);
begin
  inherited;
  fStrings  := TStringList.Create;
end;

destructor TNumberedStrings.Destroy;
begin
  fStrings.Free;
  inherited;
end;

function TNumberedStrings.GetCount: integer;
begin
  Result := fStrings.Count;
end;

function TNumberedStrings.ElemName(const i: integer): string;
begin
  Result  := 'Elem'+IntToStr(i);
end;

procedure TNumberedStrings.Loaded(Storage: ISettingsStorage);
var
  i : integer;
  Reader  : ISettingsStorageReader;
begin
  inherited;
  //  Load list of packages
  fStrings.Clear;
  Reader  := StorageAsReader(Storage);
  for i := 0 to fCount-1  do
    fStrings.Add( Reader.ReadString( ElemName(i) ) );
end;

procedure TNumberedStrings.Saving(Storage: ISettingsStorage);
var
  i : integer;
  Writer  : ISettingsStorageWriter;
begin
  inherited;
  Writer  := StorageAsWriter(Storage);
  for i := 0 to Count-1 do
    Writer.WriteString( ElemName(i), fStrings[i] );
end;

{ TFileListSettings }

function TFileListSettings.GetFileNames: TStringList;
begin
  Result  := Strings;
end;

function TFileListSettings.ElemName(const i: Integer): String;
begin
  Result  := 'File'+IntToStr(i)
end;

{ TNamedStrings }

constructor TNamedStrings.Create(const AName: string; const AParent: TSettingsGroup);
begin
  inherited;
  fNames  := TStringList.Create;
  fValues := TStringList.Create;
end;

destructor TNamedStrings.Destroy;
begin
  fNames.Free;
  fValues.Free;
  inherited;
end;

procedure TNamedStrings.FromStrings(const Strings: TStrings);
var
  i: integer;
  Name, Value: string;
begin
  for i := 0 to Strings.Count - 1 do
    begin
      //  Get valid name
      Name  := Strings.Names[i];
      if  Name = '' then
        continue;
      //  Get value
      Value := Strings.Values[Name];
      //  Assign
      Self.ByName[Name] := Value;
    end;
end;

function TNamedStrings.GetValues(const Index: integer): string;
begin
  Result  := fValues[Index]
end;

function TNamedStrings.GetByName(const Name: string): string;
var
  i: integer;
begin
  i := fNames.IndexOf(Name);
  if  i < 0 then
    Result  := ''
  else
    Result  := fValues[i]
end;

function TNamedStrings.GetCount: integer;
begin
  Result  := fValues.Count
end;

function TNamedStrings.GetNames(const Index: integer): string;
begin
  Result  := fNames[Index]
end;

procedure TNamedStrings.Loaded(Storage: ISettingsStorage);
var
  i : integer;
  Query   : ISettingsStorageQuery;
  Reader  : ISettingsStorageReader;
  Names   : TStringList;
begin
  inherited;
  Query   := StorageAsQuery(Storage);
  Reader  := StorageAsReader(Storage);
  Names   := TStringList.Create;
  try
    Query.GetSettingNames(Names);
    // Might clear settings in object before loading new settings
    if  ClearBeforeLoad then
      begin
        fNames.Clear;
        fValues.Clear;
      end;
    // Read in the settings
    for i := 0 to Names.Count-1 do
      ByName[Names[i]]  := Reader.ReadString(Names[i]);
  finally
    Names.Free;
  end;
end;

procedure TNamedStrings.Saving(Storage: ISettingsStorage);
var
  i : integer;
  Query   : ISettingsStorageQuery;
  Writer  : ISettingsStorageWriter;
  Deleter : ISettingsStorageDelete;
  Names   : TStringList;
begin
  //  Clear old settings from storage
  Query   := StorageAsQuery(Storage);
  Deleter := StorageAsDeleter(Storage);
  Names   := TStringList.Create;
  try
    Query.GetSettingNames(Names);
    for i := 0 to Names.Count-1 do
      Deleter.DeleteSetting(Names[i]);
  finally
    Names.Free;
  end;
  //  Write the settings to storage
  Writer  := StorageAsWriter(Storage);
  for i := 0 to fNames.Count-1 do
    Writer.WriteString(fNames[i], fValues[i]);
  inherited;
end;

procedure TNamedStrings.SetValues(const Index: integer; const Value: string);
begin
  fValues[Index] := Value
end;

procedure TNamedStrings.ToStrings(const Strings: TStrings);
var
  i: integer;
begin
  for i := 0 to fNames.Count - 1 do
    Strings.Values[fNames[i]] := fValues[i];
end;

procedure TNamedStrings.SetByName(const Name: string; const Value: string);
var
  i: integer;
begin
  i := fNames.IndexOf(Name);
  if  i < 0 then
    begin
      fNames.Add(Name);
      fValues.Add(Value);
    end
  else
    fValues[i]  := Value;
end;

{ TNumberedGroups }

function TNumberedGroups.AddElem: TSettingsGroup;
begin
  Result  := ElemType.Create('', Self);
end;

procedure TNumberedGroups.DelElem(const Elem: TSettingsGroup);
begin
  RemoveSubGroup( Elem );
end;

function TNumberedGroups.ElemName(const i: integer): string;
begin
  Result  := 'Item'+IntToStr(i)
end;

function TNumberedGroups.GetCount: integer;
begin
  Result := SubGroupCount;
end;

function TNumberedGroups.GetElem(const i: integer): TSettingsGroup;
begin
  Result  := SubGroups[i] as ElemType;
end;

procedure TNumberedGroups.Loaded(Storage: ISettingsStorage);
var
  i : integer;
begin
  inherited;
  //  Clear away old subgroups
  ClearSubGroups;
  //  Make sure each sub group exists so it can be loaded later in LoadAll()
  for i := 0 to fCount-1 do
    ElemType.Create( ElemName(i), Self );
end;

procedure TNumberedGroups.Saving(Storage: ISettingsStorage);
var
  i : integer;
  Deleter : ISettingsStorageDelete;
begin
  //  Remove any deleted subgroups
  Deleter := StorageAsDeleter(Storage);
  for i := fCount-1 downto 0  do
    Deleter.DeleteGroup(ElemName(i));
  //  Inherited
  inherited;
  //  Give each Elem a unique name (so they do not write over each others data)
  for i := 0 to SubGroupCount-1 do
    SubGroups[i].GroupName  := ElemName(i);
end;

{ TNumberedGroups<TSubGroup> }

function TNumberedGroups<TSubGroup>.AddElem: TSubGroup;
begin
  Result  := TSubGroup(TSettingsGroupClass(TSubGroup).Create('', Self))
end;

procedure TNumberedGroups<TSubGroup>.DelElem(const Elem: TSubGroup);
begin
  RemoveSubGroup( Elem );
end;

function TNumberedGroups<TSubGroup>.ElemName(const i: integer): string;
begin
  Result  := 'Item'+IntToStr(i)
end;

function TNumberedGroups<TSubGroup>.GetCount: integer;
begin
  Result := SubGroupCount;
end;

function TNumberedGroups<TSubGroup>.GetElem(const i: integer): TSubGroup;
begin
  Result  := SubGroups[i] as TSubGroup
end;

procedure TNumberedGroups<TSubGroup>.Loaded(Storage: ISettingsStorage);
var
  i : integer;
begin
  inherited;
  //  Clear away old subgroups
  ClearSubGroups;
  //  Make sure each sub group exists so it can be loaded later in LoadAll()
  for i := 0 to fCount-1 do
    AddElem.GroupName := ElemName(i)
end;

procedure TNumberedGroups<TSubGroup>.Saving(Storage: ISettingsStorage);
var
  i : integer;
  Deleter : ISettingsStorageDelete;
begin
  //  Remove any deleted subgroups
  Deleter := StorageAsDeleter(Storage);
  for i := fCount-1 downto 0  do
    Deleter.DeleteGroup(ElemName(i));
  //  Inherited
  inherited;
  //  Give each Elem a unique name (so they do not write over each others data)
  for i := 0 to SubGroupCount-1 do
    SubGroups[i].GroupName  := ElemName(i);
end;

{ TNamedGroups }

function TNamedGroups.AddElem(const ElemName: string): TSettingsGroup;
begin
  if  SubGroupByName( ElemName ) = nil  then
    Result  := ElemType.Create( ElemName, Self )
  else
    raise Exception.Create('Sub group '''+ElemName+''' already exists in '''+GroupPath+'''');
end;

function TNamedGroups.GetElem(const ElemName: string): TSettingsGroup;
begin
  Result  := SubGroupByName( ElemName );
  if  Result = nil  then
    raise Exception.Create('Expected settings group '''+GroupPath+SSettingsDivider+ElemName+''' to be of type '+ElemType.ClassName+' but it is nil.')
  else if not (Result is ElemType)  then
    raise Exception.Create('Expected settings group '''+GroupPath+SSettingsDivider+ElemName+''' to be of type '+ElemType.ClassName+' but it is of type '+Result.ClassName);
end;

procedure TNamedGroups.Loaded(Storage: ISettingsStorage);
var
  Query : ISettingsStorageQuery;
  GroupNames  : TStringList;
  SubGroup : TSettingsGroup;
  i : integer;
begin
  inherited;
  GroupNames  := TStringList.Create;
  try
    if  Supports( Storage, ISettingsStorageQuery, Query ) then
      begin
        //  Get the names of the sub groups in the storage
        Query.GetGroupNames( GroupNames );
        //  Make sure each sub group exists so it can be loaded later in LoadAll()
        for i := 0 to GroupNames.Count-1  do
          begin
            SubGroup  := SubGroupByName( GroupNames[i] );
            if  SubGroup = nil  then
              AddElem( GroupNames[i] );
          end;
      end;
  finally
    GroupNames.Free;
  end;
end;

procedure TNamedGroups.RemElem(const ElemName: string);
begin
  RemoveSubGroup( SubGroupByName( ElemName ) );
end;

procedure TNamedGroups.Saving(Storage: ISettingsStorage);
var
  i: integer;
begin
  //  Remove any changed or deleted subgroups
  //  (Actually delete all, as existing settings groups will be saved.)
  for i := 0 to SubGroupCount-1 do
    if  SubGroups[i] is ElemType  then  // Don't delete groups that aren't Elems.
      Storage.DeleteAll( SubGroups[i] );
  //  Inherited
  inherited;
end;

{ TNamedGroups<TSubGroup> }

function TNamedGroups<TSubGroup>.AddElem(const ElemName: string): TSubGroup;
begin
  if  SubGroupByName( ElemName ) = nil  then
    Result  := TSubGroup(TSettingsGroupClass(TSubGroup).Create( ElemName, Self ))
  else
    raise Exception.Create('Sub group '''+ElemName+''' already exists in '''+GroupPath+'''');
end;

function TNamedGroups<TSubGroup>.GetElem(const ElemName: string): TSubGroup;
begin
  Result  := SubGroupByName( ElemName ) as TSubGroup;
  if  Result = nil  then
    raise Exception.Create('Expected settings group '''+GroupPath+SSettingsDivider+ElemName+''' to be of type '+TSubGroup.ClassName+' but it is nil.')
  else if not (Result is TSubGroup)  then
    raise Exception.Create('Expected settings group '''+GroupPath+SSettingsDivider+ElemName+''' to be of type '+TSubGroup.ClassName+' but it is of type '+Result.ClassName);
end;

function TNamedGroups<TSubGroup>.GetSubGroups(const i: integer): TSubGroup;
begin
  Result  := inherited SubGroups[i] as TSubGroup
end;

procedure TNamedGroups<TSubGroup>.Loaded(Storage: ISettingsStorage);
var
  Query : ISettingsStorageQuery;
  GroupNames  : TStringList;
  SubGroup : TSettingsGroup;
  i : integer;
begin
  inherited;
  GroupNames  := TStringList.Create;
  try
    if  Supports( Storage, ISettingsStorageQuery, Query ) then
      begin
        //  Get the names of the sub groups in the storage
        Query.GetGroupNames( GroupNames );
        //  Make sure each sub group exists so it can be loaded later in LoadAll()
        for i := 0 to GroupNames.Count-1  do
          begin
            SubGroup  := SubGroupByName( GroupNames[i] );
            if  SubGroup = nil  then
              AddElem( GroupNames[i] );
          end;
      end;
  finally
    GroupNames.Free;
  end;
end;

procedure TNamedGroups<TSubGroup>.RemElem(const ElemName: string);
begin
  RemoveSubGroup( SubGroupByName( ElemName ) );
end;

procedure TNamedGroups<TSubGroup>.Saving(Storage: ISettingsStorage);
var
  i: integer;
begin
  //  Remove any changed or deleted subgroups
  //  (Actually delete all, as existing settings groups will be saved.)
  for i := 0 to SubGroupCount-1 do
    if  SubGroups[i] is TSubGroup then  // Don't delete groups that aren't Elems.
      Storage.DeleteAll( SubGroups[i] );
  //  Inherited
  inherited;
end;

{ TComponentSettings }

function TComponentSettings.Load(const Obj: TComponent; Name: string): Boolean;
const
  FuncName  = 'Load';
var
  Setting : string;
  Stream  : TStringStream;
begin
  Result  := False;
  ValidateParameters(FuncName, Obj, Name);
  //  Fetch the settings
  Setting := ByName[Name];
  if  Setting = ''  then
    exit;
  //  Apply the settings to Obj
  Stream  := TStringStream.Create(Setting);
  try
    Stream.ReadComponent(Obj);
  finally
    Stream.Free;
  end;
  Result  := True;
end;

procedure TComponentSettings.Save(const Obj: TComponent);
const
  FuncName  = 'Save';
var
  Name    : string;
  Setting : string;
  Stream  : TStringStream;
begin
  Name  := '';
  ValidateParameters(FuncName, Obj, Name);
  //  Collect settings from Obj
  Stream  := TStringStream.Create('');
  try
    Stream.WriteComponent(Obj);
    Setting := Stream.ReadString(Stream.Size);
  finally
    Stream.Free;
  end;
  //  Keep the string
  ByName[Name] := Setting;
end;

procedure TComponentSettings.ValidateParameters(const FuncName: string;
  const Obj: TComponent; var Name: string);
begin
  if  Obj = nil then
    raise EPtSettings.Create(ClassName+'.'+FuncName+'() requires an object.');
  if  Name = '' then
    Name  := Obj.Name;
  if  Name = '' then
    raise EPtSettings.Create(ClassName+'.'+FuncName+'() requires a name.');
end;

end.
